home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / info-service / gopher / Unix / gateways / gonnrp / gonnrp-2.0 < prev    next >
Encoding:
Text File  |  1993-05-28  |  8.0 KB  |  309 lines

  1. #!/bin/perl 
  2. # Gopher-nnrp Gateway version 2.0  rewrite by: Chad Adams (c-adams@bgu.edu)
  3. # 28-May-1993 version 2.0 Chad Adams
  4. # add newgroups database.
  5. # add multi level newsgroup menus.  [each .part. of newsgroup automaticly
  6. #   gets it's own menu instead of putting all (like all of comp) in one
  7. #   menu.  {now menus like comp.sys, comp.lang, comp.sources, ect..}]
  8. # convert to use xhdr instead of tin's xindex.  If not used with INN using
  9. #   overview files to speed up xhdr it may be slow.
  10. #
  11. # Gopher-NNTP Gateway version 1.0
  12. # Author: Daniel Schales (dan@engr.latech.edu)
  13. # Major rewrite, socket support: Doug Schales (d1s8027@sc.tamu.edu)
  14. #
  15. # Set the 4 following variables for your setup. the 2 port variables
  16. # are set to the standard, be sure to set gopherhost and nntphost to
  17. # your respective hosts.
  18. $gopherhost="news.ecn.bgu.edu";
  19. $gopherport=2008;
  20. # $nntpprt='gopher-nntp';
  21. $nntpprt='nntp';
  22. $nntphost="news.ecn.bgu.edu";
  23.  
  24.  
  25. @INC=("/usr/local/lib/perl");
  26. require 'sys/socket.ph';
  27. dump QUICKSTART if @ARGV[0] eq '-dump';
  28. QUICKSTART:
  29.  
  30. $SIG{'ALRM'} = 'stuck';
  31. $option=shift;
  32. $option = '-h' if $option eq '-t';
  33. while ($option eq '-f') {
  34.       $copyright = shift;
  35.       $option = shift;
  36.       open(CR, $copyright);
  37.       $title = <CR>;
  38.       close(CR);
  39.       chop($title);
  40.       print "0$title\t$copyright\t$gopherhost\t$gopherport\r\n";
  41. }
  42. $item=shift;
  43. if ($option eq '-X') {
  44.     @arts = @ARGV;
  45. } else {
  46.     $lookup=shift;
  47. }
  48. # set an alarm 5 minutes from now, if it goes off we must be stuck
  49. alarm(300);
  50. open(LOG,">>/tmp/nntplog");
  51. $date=`date`;chop($date);
  52. print LOG $date," ",$option," ",$item," ",$lookup,"\n";
  53. close(LOG);
  54. $sockaddr = 'S n a4 x8';
  55. ($name, $aliases, $proto) = getprotobyname('tcp');
  56. ($name, $aliases, $nntpport) = getservbyname($nntpprt, 'tcp');
  57. ($name, $aliases, $type, $len, $nntpaddr) = gethostbyname($nntphost);
  58.  
  59. $rsockaddr = pack($sockaddr, &AF_INET, $nntpport, $nntpaddr);
  60.  
  61. socket(NNTPSOCK, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
  62. connect(NNTPSOCK, $rsockaddr) || die "connect: $!";
  63.  
  64. select(NNTPSOCK); $|= 1; select(stdout);
  65.  
  66. $_ = <NNTPSOCK>;
  67.  
  68. if ($option eq '-g') {
  69.     dbmopen(newsgroups, '/usr/lib/newsgroups', 0444);
  70.     print NNTPSOCK "LIST\n";
  71.     $_ = <NNTPSOCK>;
  72.     chop; chop;
  73.     while($_ ne "."){
  74.     if($_ =~ "^$item"){
  75.         ($group) = split;
  76.         push(@out,"1$group - $newsgroups{$group}\texec:-h $group:".
  77.             "/bin/gonnrp\t$gopherhost\t$gopherport\r\n");
  78.     }
  79.     $_ = <NNTPSOCK>;
  80.     chop; chop;
  81.     }
  82.     print sort(@out);
  83.     print ".\r\n";
  84. } elsif ($option eq '-G') {
  85.     dbmopen(newsgroups, '/usr/lib/newsgroups', 0444);
  86.     print NNTPSOCK "LIST\n";
  87.     $_ = <NNTPSOCK>;
  88.     chop; chop;
  89.     $itemlen = length($item) + 1;
  90.     @grouplist = ();
  91.     while($_ ne "."){
  92.     if($_ =~ "^$item"){
  93.             ($group) = split;
  94.         push(@grouplist, $group);
  95.     }
  96.         $_ = <NNTPSOCK>;
  97.         chop; chop;
  98.     }
  99.     @grouplist = sort(@grouplist);
  100.     for ($i = 0; $i <= $#grouplist; $i++) {
  101.         $group = @grouplist[$i];
  102.         if ($group eq $item) {
  103.         $grp = $group;
  104.             print "1$newsgroups{$group}\texec:-T $group:".
  105.             "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  106.         } else {
  107.         $grp = substr($group,$itemlen,40);
  108.         if (index($grp,'.') != -1) {
  109.             @grppart = split(/\./,$grp);
  110.             if (@grppart[0] eq $oldgrp) {
  111.             next;
  112.             }
  113.             $oldgrp = @grppart[0];
  114.             $grp = @grppart[0];
  115.                 print "1$grp - ".$newsgroups{"$item.$grp.all"}.
  116.             "\texec:-G $item.$grp".
  117.             ":/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  118.         } else {
  119.             if ($group eq substr(@grouplist[$i+1],0,length($group))) {
  120.                     print "1$grp - ".$newsgroups{"$item.$grp.all"}.
  121.                 "\texec:-G $group:".
  122.                 "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  123.             $oldgrp = $grp;
  124.             } else {
  125.                     print "1$grp - $newsgroups{$group}\texec:-T $group:".
  126.                 "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  127.             }
  128.         }
  129.         }
  130.     }
  131.     print ".\r\n";
  132. } elsif($option eq '-X') {
  133. #    $item = newsgroup
  134. #    @arts = articles in this thread
  135. #      or
  136. #    @arts = 0 low high  if list would be too long
  137.     ($code) = &group($item);
  138.     # build arts array if we were passed range
  139.     @arts = split(' ', &buildidx(@arts[1], @arts[2])) if @arts[0] == 0;
  140.     foreach $art (@arts) { $goodart{$art} = 1; }
  141.     &xhdr('from', @arts[0], @arts[$#arts]);
  142.     while (<NNTPSOCK>) {
  143.         last if substr($_,0,1) eq '.';
  144.         chop; chop;
  145.         ($art, $from) = split(/ /,$_,2);
  146.         print "0$from\texec:-a ${item} $art:/bin/gonnrp\t".
  147.             "$gopherhost\t$gopherport\r\n" if $goodart{$art};
  148.     }
  149.     print ".\r\n";
  150. } elsif($option eq '-T') {
  151.     ($code, $cnt, $low, $high) = &group($item);
  152.     &buildidx($low, $high);
  153.     @keys = sort(keys %idx);
  154.     foreach $key (@keys) {
  155.         @arts = split(' ',$idx{$key});
  156.         if ($#arts == 0) { # single article
  157.             print "0$key\texec:-a ${item} @arts[0]:".
  158.               "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  159.         } else { # thread
  160.             if (length($idx{$key}) < 80) { # send article list
  161.                 print "1$key\texec:-X $item$idx{$key}:".
  162.                   "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  163.             } else { # give range
  164.                 print "1$key\texec:".
  165.                   "-X $item 0 @arts[0] @arts[$#arts]:".
  166.                   "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  167.             }
  168.         }
  169.     }
  170.     print ".\r\n";
  171. } elsif($option eq '-l'){
  172.     ($code, $count, $start, $end) = &group($item);
  173.     if($count ne "0"){
  174.         print NNTPSOCK "ARTICLE $end\n";
  175.         $body=0;
  176.         $_ = <NNTPSOCK>;
  177.         chop; chop;
  178.         while($_ ne "."){
  179.             if ($body) {
  180.                 print "$_\r\n";
  181.             } elsif ($_ =~ "^220 " || $_ =~ "^222 ") {
  182.                 $body = 1;
  183.             }
  184.         }
  185.              $_ = <NNTPSOCK>;
  186.              chop; chop;
  187.      }
  188. }
  189. # rwp 20Aug92 Add ability to fetch last article.
  190.  
  191. elsif($option eq '-h' || $option eq '-b' || $option eq '-s'){
  192.     ($code, $count, $start, $end) = &group($item);
  193.     if($count ne "0"){
  194.         &xhdr('subject', $start, $end);
  195.         $_ = <NNTPSOCK>;
  196.         chop; chop;
  197.         while($_ ne '.'){
  198.             ($num,$desc) = split (/ /,$_,2);
  199.             if ($option eq '-h' ) {
  200.                 print "0$desc\texec:-a ${item} ${num}:".
  201.                   "/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  202.             } elsif ($option eq '-b') {
  203.                 print "0$desc\texec:-a ${item} ${num} body".
  204.                   ":/bin/gonnrp\t$gopherhost\t$gopherport\r\n";
  205.             } elsif ($option eq '-s') {
  206.                 $desc1="\L$desc\E";
  207.                 $lookup1 ="\L$lookup\E";
  208.                 if ($desc1 =~ $lookup1 ) {
  209.                  print "0$desc\texec:-a ${item} ${num}:".
  210.                   "/bin/gonnrp\t$gopherhost\t$gopherport\t\r\n";
  211.                 }
  212.             }
  213.             $_ = <NNTPSOCK>;
  214.             chop; chop;
  215.         }
  216.     }
  217.     print ".\r\n";
  218. } elsif($option eq '-a'){
  219.     $num = $lookup;
  220.     $part = shift;
  221.     ($code) = &group($item);
  222.     if($part eq "body") {
  223.         print NNTPSOCK "BODY $num\n";
  224.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  225.         &checkcode($code,222);
  226.     } else {
  227.         print NNTPSOCK "ARTICLE $num\n";
  228.         ($code) = split(/ /,($_ = <NNTPSOCK>));
  229.         &checkcode($code,220);
  230.     }
  231.     $_ = <NNTPSOCK>;
  232.     chop; chop;
  233.     while($_ ne "."){
  234.         print "$_\r\n";
  235.         $_ = <NNTPSOCK>;
  236.         chop; chop;
  237.     }
  238. }
  239.  
  240. print NNTPSOCK "QUIT\n";
  241. shutdown(NNTPSOCK, 2);
  242. exit(0);
  243.  
  244. sub stuck {
  245. open(LOG,">>/tmp/nntplog");
  246. $date=`date`;chop($date);
  247. print LOG $date," hung on ",$option," ",$item," ",$lookup,"\n";
  248. close(LOG);
  249.  
  250. exit;
  251. }
  252.  
  253. # Chad Adams  28-May-1993  tin's xindex to xhdr conversion
  254. sub checkcode { # return error when nntp command failes
  255.     local($code, $goodcode) = @_;
  256.     if ($code != $goodcode) {
  257.         print "0$_\t\t\t\r\n";
  258.         print ".\r\n";
  259.         exit;
  260.     }
  261. }
  262. sub buildidx {    # build subject threads
  263.     local ($low, $high) = @_;
  264.     local ($first, $fsubj, $re, $subj);
  265.     $first = 1;
  266.     &xhdr('subject', $low, $high);
  267.     $cnt = 0;
  268.     while (<NNTPSOCK>) {
  269.         last if substr($_,0,1) eq '.';
  270.         chop; chop;
  271.         ($art, $subj) = split(/ /,$_,2);
  272.         while (1) { # remove Re:
  273.             $re = substr($subj,0,2);
  274.             $re =~ tr/A-Z/a-z/;
  275.             if ($re eq 're') {
  276.                 $subj = substr($subj,2);
  277.                 next;
  278.             } elsif (substr($subj,0,1) eq ':') {
  279.                 $subj = substr($subj,1);
  280.                 next;
  281.             } elsif (substr($subj,0,1) eq ' ') {
  282.                 $subj = substr($subj,1);
  283.                 next;
  284.             }
  285.             last;
  286.         }
  287.         if ($first) {
  288.             $fsubj = $subj;
  289.             $first = 0;
  290.         }
  291.         $idx{$subj} .= " $art";
  292.         $cnt++;
  293.     }
  294.     return $idx{$fsubj};
  295. }
  296. sub group { # (code, count, low, high) = &group(newsgroup)
  297.     local(@rtn);
  298.     print NNTPSOCK "group @_[0]\n";
  299.     @rtn = split(/ /,($_ = <NNTPSOCK>), 5);
  300.     &checkcode(@rtn[0],211);
  301.     return @rtn;
  302. }
  303. sub xhdr { # &xhdr(header,low,high)
  304.     local($code);
  305.     print NNTPSOCK "xhdr @_[0] ".@_[1].'-'.@_[2]."\n";
  306.     ($code) = split(/ /,($_ = <NNTPSOCK>));
  307.     &checkcode($code,221);
  308. }
  309.